home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / winmac32 / srmain.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  16KB  |  578 lines
  1. {$I SRCOMOPT.INC}
  2. unit Srmain;
  3.  
  4. interface
  5.  
  6. uses Windows, Classes, Graphics, Forms, Controls, WMacro,
  7.   StdCtrls, SysUtils, Messages, Dialogs, ComCtrls, Grids;
  8.  
  9. type
  10.   TSuperRecorder = class(TForm)
  11.     MacroSet1: TMacroSet;
  12.     Label2: TLabel;
  13.     gbGlobalSettings: TGroupBox;
  14.     SaveBtn: TButton;
  15.     LoadBtn: TButton;
  16.     Merge: TCheckBox;
  17.     RecordKeyMsg: TLabel;
  18.     ScrapMacroKeyMsg: TLabel;
  19.     CancelKeyMsg: TLabel;
  20.     Memo1: TMemo;
  21.     PauseKeyMsg: TLabel;
  22.     DeleteBtn: TButton;
  23.     gbMouseRelevant: TGroupBox;
  24.     MousePointer: TRadioButton;
  25.     MouseWindow: TRadioButton;
  26.     MouseScreen: TRadioButton;
  27.     OpenDialog1: TOpenDialog;
  28.     SaveDialog1: TSaveDialog;
  29.     btSendKeys: TButton;
  30.     edSendKeys: TEdit;
  31.     btAppActivate: TButton;
  32.     gbToggles: TGroupBox;
  33.     CapsLockButton: TButton;
  34.     NumlockButton: TButton;
  35.     ScrollLockButton: TButton;
  36.     edAppActivate: TEdit;
  37.     StringGrid1: TStringGrid;
  38.     CancelCheck: TCheckBox;
  39.     FastPlay: TCheckBox;
  40.     SysWide: TCheckBox;
  41.     gbMouseMessages: TGroupBox;
  42.     MouseNone: TRadioButton;
  43.     MouseClicks: TRadioButton;
  44.     MouseEverything: TRadioButton;
  45.     btApply: TButton;
  46.     gbNewMacro: TGroupBox;
  47.     MacroKeyComboBox1: TMacroKeyComboBox;
  48.     edMacroName: TEdit;
  49.     btCreateKeyMacro: TButton;
  50.     btCreateCodeMacro: TButton;
  51.     Label7: TLabel;
  52.     Label8: TLabel;
  53.     StatusBar1: TStatusBar;
  54.     procedure FastPlayClick(Sender: TObject);
  55.     procedure SysWideClick(Sender: TObject);
  56.     procedure MouseNoneClick(Sender: TObject);
  57.     procedure MouseClicksClick(Sender: TObject);
  58.     procedure MouseEverythingClick(Sender: TObject);
  59.     procedure btCreateKeyMacroClick(Sender: TObject);
  60.     procedure btApplyClick(Sender: TObject);
  61.     procedure FormCreate(Sender: TObject);
  62.     procedure MacroSet1Played(Sender: TObject; State: TUserMacroEngineState);
  63.     procedure SaveBtnClick(Sender: TObject);
  64.     procedure LoadBtnClick(Sender: TObject);
  65.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  66.     procedure btCreateCodeMacroClick(Sender: TObject);
  67.     procedure CancelCheckClick(Sender: TObject);
  68.     procedure DeleteBtnClick(Sender: TObject);
  69.     procedure MousePointerClick(Sender: TObject);
  70.     procedure MouseWindowClick(Sender: TObject);
  71.     procedure MouseScreenClick(Sender: TObject);
  72.     procedure btSendKeysClick(Sender: TObject);
  73.     procedure MacroSet1Assigned(Sender: TObject; Macro: Pointer);
  74.     procedure btAppActivateClick(Sender: TObject);
  75.     procedure CapsLockButtonClick(Sender: TObject);
  76.     procedure ScrollLockButtonClick(Sender: TObject);
  77.     procedure NumlockButtonClick(Sender: TObject);
  78.     procedure FormActivate(Sender: TObject);
  79.   private
  80.     { Private declarations }
  81.   public
  82.     { Public declarations }
  83.   end;
  84.  
  85. var
  86.   SuperRecorder: TSuperRecorder;
  87.   OurWindow : HWND;
  88.   OldCursor,BIGPOINT : HCursor;
  89.  
  90. implementation
  91. const
  92.   OffOn : array[boolean] of string = ('OFF','ON ');
  93.   SlowMouseVDelta = 5;
  94.   SlowMouseHDelta = 5;
  95.   FastMouseVDelta = 30;
  96.   FastMouseHDelta = 30;
  97.  
  98. {$R *.DFM}
  99. {$R BIGPOINT.RES}
  100.  
  101. procedure TSuperRecorder.FastPlayClick(Sender: TObject);
  102. begin
  103.   MacroSet1.FastPlayback:=FastPlay.Checked;
  104. end;
  105.  
  106. procedure TSuperRecorder.SysWideClick(Sender: TObject);
  107. begin
  108.   MacroSet1.SystemWide:=SysWide.Checked;
  109. end;
  110.  
  111. procedure TSuperRecorder.MouseNoneClick(Sender: TObject);
  112. begin
  113.   If MouseNone.Checked then MacroSet1.RecordMouse:=RMIgnore;
  114. end;
  115.  
  116. procedure TSuperRecorder.MouseClicksClick(Sender: TObject);
  117. begin
  118.   If MouseClicks.Checked then MacroSet1.RecordMouse:=RMClicksAndDrags;
  119. end;
  120.  
  121. procedure TSuperRecorder.MouseEverythingClick(Sender: TObject);
  122. begin
  123.   If MouseEverything.Checked then MacroSet1.RecordMouse:=RMAll;
  124. end;
  125.  
  126. procedure TSuperRecorder.btCreateKeyMacroClick(Sender: TObject);
  127. begin
  128.   try
  129.     With MacroSet1, MacroKeyComboBox1 do
  130.       If (MKey>0) then Add(MKey,ScrapMacro,edMacroName.Text,nil);
  131.   except
  132.   on Exception Do MessageBox(0,'An error occurred while adding the key macro','',MB_APPLMODAL);
  133.   end;
  134. end;
  135.  
  136. procedure TSuperRecorder.btApplyClick(Sender: TObject);
  137. begin
  138.   With MacroSet1 do begin
  139.     If MacrosOn then MacrosOff;
  140.     MacrosOn;
  141.   end;
  142.   
  143.   MacroSet1Assigned(Sender,nil);
  144. end;
  145.  
  146. function GetTopLevelWindow(Handle : HWND) : HWND;
  147. begin
  148.   while (GetParent(Handle)<>0) do Handle:=GetParent(Handle);
  149.   result:=Handle;
  150. end;
  151.  
  152. procedure ExampleCodeMacroProcedure; export;
  153. begin
  154.   MessageBox(0,'Example Code Macro Procedure','',MB_APPLMODAL);
  155. end;
  156.  
  157. Procedure RunProg(const Prog : Pchar);
  158. begin
  159.   WinExec(Prog,SW_SHOWNORMAL);
  160. end;
  161.  
  162. procedure RunCalc; export;
  163. begin
  164.   RunProg('CALC.EXE');
  165. end;
  166.  
  167. procedure RunNotePad; export;
  168. begin
  169.   RunProg('NOTEPAD.EXE');
  170. end;
  171.  
  172. procedure RunCalendar; export;
  173. begin
  174.   RunProg('CALENDAR.EXE');
  175. end;
  176.  
  177. procedure RunClock; export;
  178. begin
  179.   RunProg('CLOCK.EXE');
  180. end;
  181.  
  182. procedure MoveMouseUp; export;
  183. var
  184.   MousePos : TPoint;
  185. begin
  186.   GetCursorPos(MousePos);
  187.   MousePos.y:=MousePos.y-SlowMouseVDelta;
  188.   If (MousePos.y<0) then MousePos.y:=0;
  189.   SetCursorPos(MousePos.x,MousePos.y);
  190. end;
  191.  
  192. procedure MoveMouseLeft; export;
  193. var
  194.   MousePos : TPoint;
  195. begin
  196.   GetCursorPos(MousePos);
  197.   MousePos.x:=MousePos.x-SlowMouseHDelta;
  198.   If (MousePos.x<0) then MousePos.x:=0;
  199.   SetCursorPos(MousePos.x,MousePos.y);
  200. end;
  201.  
  202. procedure MoveMouseRight; export;
  203. var
  204.   MousePos : TPoint;
  205. begin
  206.   GetCursorPos(MousePos);
  207.   MousePos.x:=MousePos.x+SlowMouseHDelta;
  208.   SetCursorPos(MousePos.x,MousePos.y);
  209. end;
  210.  
  211. procedure MoveMouseDown; export;
  212. var
  213.   MousePos : TPoint;
  214. begin
  215.   GetCursorPos(MousePos);
  216.   MousePos.y:=MousePos.y+SlowMouseVDelta;
  217.   SetCursorPos(MousePos.x,MousePos.y);
  218. end;
  219.  
  220. procedure MoveMouseUpFast; export;
  221. var
  222.   MousePos : TPoint;
  223. begin
  224.   GetCursorPos(MousePos);
  225.   MousePos.y:=MousePos.y-FastMouseVDelta;
  226.   If (MousePos.y<0) then MousePos.y:=0;
  227.   SetCursorPos(MousePos.x,MousePos.y);
  228. end;
  229.  
  230. procedure MoveMouseLeftFast; export;
  231. var
  232.   MousePos : TPoint;
  233. begin
  234.   GetCursorPos(MousePos);
  235.   MousePos.x:=MousePos.x-FastMouseHDelta;
  236.   If (MousePos.x<0) then MousePos.x:=0;
  237.   SetCursorPos(MousePos.x,MousePos.y);
  238. end;
  239.  
  240. procedure MoveMouseRightFast; export;
  241. var
  242.   MousePos : TPoint;
  243. begin
  244.   GetCursorPos(MousePos);
  245.   MousePos.x:=MousePos.x+FastMouseHDelta;
  246.   SetCursorPos(MousePos.x,MousePos.y);
  247. end;
  248.  
  249. procedure MoveMouseDownFast; export;
  250. var
  251.   MousePos : TPoint;
  252. begin
  253.   GetCursorPos(MousePos);
  254.   MousePos.y:=MousePos.y+FastMouseVDelta;
  255.   SetCursorPos(MousePos.x,MousePos.y);
  256. end;
  257.  
  258. procedure MoveMouseUpperLeft; export;
  259. var
  260.   MousePos : TPoint;
  261. begin
  262.   With MousePos do begin
  263.     x:=0;
  264.     y:=0;
  265.   end;
  266.   SetCursorPos(MousePos.x,MousePos.y);
  267. end;
  268.  
  269. procedure MoveMouseUpperRight; export;
  270. var
  271.   MousePos : TPoint;
  272. begin
  273.   With MousePos do begin
  274.     x:=2048;
  275.     y:=0;
  276.   end;
  277.   SetCursorPos(MousePos.x,MousePos.y);
  278. end;
  279.  
  280. procedure MoveMouseLowerLeft; export;
  281. var
  282.   MousePos : TPoint;
  283.   ScreenHeight : Integer;
  284. begin
  285.   ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
  286.   With MousePos do begin
  287.     x:=0;
  288.     y:=ScreenHeight;
  289.   end;
  290.   SetCursorPos(MousePos.x,MousePos.y);
  291. end;
  292.  
  293. procedure MoveMouseLowerRight; export;
  294. var
  295.   MousePos : TPoint;
  296.   ScreenWidth, ScreenHeight : Integer;
  297. begin
  298.   ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
  299.   ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
  300.   With MousePos do begin
  301.     x:=ScreenWidth;
  302.     y:=ScreenHeight;
  303.   end;
  304.   SetCursorPos(MousePos.x,MousePos.y);
  305. end;
  306.  
  307. procedure MoveMouseCenter; export;
  308. var
  309.   MousePos : TPoint;
  310.   ScreenWidth, ScreenHeight : Integer;
  311. begin
  312.   ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
  313.   ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
  314.   With MousePos do begin
  315.     x:=ScreenWidth div 2;
  316.     y:=ScreenHeight div 2;
  317.   end;
  318.   SetCursorPos(MousePos.x,MousePos.y);
  319. end;
  320.  
  321. procedure MagnifyPointer; export;
  322. var
  323.   CurCursor : HCursor;
  324. begin
  325.   CurCursor:=GetCursor;
  326.   If (CurCursor<>BIGPOINT) then begin
  327.     OldCursor:=CurCursor;
  328.     SetCursor(BIGPOINT);
  329.   end;
  330. end;
  331.  
  332. procedure ShrinkPointer; export;
  333. var
  334.   CurCursor : HCursor;
  335. begin
  336.   CurC